home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / oop.swg / 0045_Change T.V. Colors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-26  |  4.9 KB  |  188 lines
  1. program Color;
  2.  
  3. {$R color.res }
  4.  
  5. uses
  6.   WinProcs,
  7.   WinTypes,
  8.   WObjects;
  9.  
  10. const
  11.   White        = $00FFFFFF;
  12.   Black        = $00000000;
  13.   LightGray    = $00C0C0C0;
  14.   DarkGray     = $00808080;
  15.   Cyan         = $00FFFF00;
  16.   Magenta      = $00FF00FF;
  17.   Yellow       = $0000FFFF;
  18.   Red          = $000000FF;
  19.   Green        = $0000FF00;
  20.   Blue         = $00FF0000;
  21.   LightBlue    = $00800000;
  22.   LightCyan    = $00808000;
  23.   LightMagenta = $00800080;
  24.   Brown        = $00008080;
  25.   LightRed     = $00000080;
  26.   LightGreen   = $00008000;
  27.  
  28. const
  29.   id_Color = 101;
  30.  
  31. type
  32.   PColorDialog = ^TColorDialog;
  33.   TColorDialog = object(TDialog)
  34.     ColorPtr : ^longint;
  35.     constructor Init(AParent : PWindowsObject; var AColor : longint);
  36.     procedure SetupWindow; virtual;
  37.     function CanClose : boolean; virtual;
  38.     procedure wmDrawItem(var Msg : TMessage); virtual wm_First+wm_DrawItem;
  39.     procedure wmMeasureItem(var Msg : TMessage); virtual wm_First+wm_MeasureItem;
  40.   end;
  41.  
  42. constructor TColorDialog.Init(AParent : PWindowsObject; var AColor : longint);
  43. begin
  44.   TDialog.Init(AParent,'ColorDlg');
  45.   ColorPtr := @AColor;
  46. end; { Init }
  47.  
  48. procedure TColorDialog.SetupWindow;
  49. const
  50.   NColors = 16;
  51.   StdColors : array[1..NColors] of longint =
  52.    (White, Black, LightGray, DarkGray, Cyan, Magenta, Yellow, Red, Green,
  53.     Blue, LightBlue, LightCyan, LightMagenta, Brown, LightRed, LightGreen);
  54.  
  55.   procedure SetupColors(ID : integer; Color : longint);
  56.   var
  57.     i,Sel : integer;
  58.   begin
  59.     Sel := -1;
  60.     for i := 1 to NColors do begin
  61.       SendDlgItemMsg(ID,cb_AddString,0,StdColors[i]);
  62.       if StdColors[i] = Color then Sel := pred(i);
  63.     end;
  64.     if Sel = -1 then begin
  65.       SendDlgItemMsg(ID,cb_AddString,0,Color);
  66.       Sel := NColors;
  67.     end;
  68.     SendDlgItemMsg(ID,cb_SetCurSel,Sel,0);
  69.   end; { SetupColors }
  70.  
  71. begin { SetupWindow }
  72.   TDialog.SetupWindow;
  73.   SetupColors(id_Color,ColorPtr^);
  74. end; { SetupWindow }
  75.  
  76. function TColorDialog.CanClose : boolean;
  77.  
  78.   procedure GetCol(ID : integer; var Color : longint);
  79.   var
  80.     Sel : integer;
  81.   begin
  82.     Sel := SendDlgItemMsg(ID,cb_GetCurSel,0,0);
  83.     if Sel > -1 then
  84.       SendDlgItemMsg(ID,cb_GetLBText,Sel,longint(@Color));
  85.   end; { GetCol }
  86.  
  87. begin { CanClose }
  88.   GetCol(id_Color,ColorPtr^);
  89.   CanClose := true;
  90. end; { CanClose }
  91.  
  92.  
  93. procedure TColorDialog.wmDrawItem(var Msg : TMessage);
  94. var
  95.   Brush : HBrush;
  96. begin
  97.   with PDrawItemStruct(Msg.lParam)^ do begin
  98.     if CtlType = odt_ComboBox then begin
  99.       if ((ItemAction and oda_DrawEntire) <> 0) or
  100.          ((ItemAction and oda_Select) <> 0) then begin
  101.         Brush := CreateSolidBrush(ItemData);
  102.         FillRect(hDC,rcItem,Brush);
  103.         DeleteObject(Brush);
  104.       end;
  105.       if ((ItemState and ods_Focus) <> 0) or
  106.          ((ItemState and ods_Selected) <> 0) then begin
  107.         InflateRect(rcItem,-2,-2);
  108.         DrawFocusRect(hDC,rcItem);
  109.       end;
  110.     end;
  111.   end;
  112. end; { wmDrawItem }
  113.  
  114. procedure TColorDialog.wmMeasureItem(var Msg : TMessage);
  115. begin
  116.   PMeasureItemStruct(Msg.lParam)^.ItemHeight := 16;
  117. end; { wmMeasureItem }
  118.  
  119. const
  120.   cm_Color = 100;
  121.  
  122. type
  123.   PColorWindow = ^TColorWindow;
  124.   TColorWindow = object(TWindow)
  125.     Color : longint;
  126.     constructor Init;
  127.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
  128.     procedure CMColor(var Msg: TMessage);
  129.       virtual cm_First + cm_Color;
  130.   end;
  131.  
  132. constructor TColorWindow.Init;
  133. begin
  134.   Color := White;
  135.   TWindow.Init(nil, 'Color Combo Demo');
  136.   Attr.Menu := LoadMenu(HInstance, 'Menu');
  137. end; { Init }
  138.  
  139. procedure TColorWindow.cmColor(var Msg: TMessage);
  140. begin
  141.   if Application^.ExecDialog(
  142.        New(PColorDialog,Init(@Self,Color))) = id_Ok then
  143.     InvalidateRect(HWindow,nil,true);
  144. end; { cmColor }
  145.  
  146. procedure TColorWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  147. var
  148.   Brush : HBrush;
  149. begin
  150.   Brush := CreateSolidBrush(Color);
  151.   FillRect(PaintDC,PaintInfo.rcPaint,Brush);
  152.   DeleteObject(Brush);
  153. end; { Paint }
  154.  
  155. type
  156.   TColorApp = object(TApplication)
  157.     procedure InitMainWindow; virtual;
  158.   end;
  159.  
  160. procedure TColorApp.InitMainWindow;
  161. begin
  162.   MainWindow := New(PColorWindow,Init);
  163. end; { InitMainWindow }
  164.  
  165. var
  166.   ColorApp: TColorApp;
  167.  
  168. begin
  169.   ColorApp.Init('Menu');
  170.   ColorApp.Run;
  171.   ColorApp.Done;
  172. end.
  173.  
  174. { -------------------------  COLOR.RES ----------------------- }
  175.  
  176. { USE XX3402 to decode the following block                              }
  177. { Cut out and name COLOR.XX.  Use XX3402 d COLOR.XX to create COLOR.RES }
  178.  
  179. { ------------------------    CUT -----------------------------}
  180.  
  181. *XX3402-000206-140792--72--85-25021-------COLOR.RES--1-OF--1
  182. zkE+HIJCJE+k2+w+++++++++U+-Y+0N1PqljQU1z-E-1HolDIYFAFk+k25I+++1++AW+-3Q+
  183. 7U-l+2s+++-1O4xjQqIUMqxgPr6+0+-6NKlq++Q+0E+M++c+zzw+++-EUYBjP4xmCU++6++4
  184. +-s+D+-Z+-A+6J03++-4++M+6k+A++2++E+-I6-DOk++FU+N+0A+1++0+++++J0+Eq3iMqJg
  185. ++1z1k1z+E+k2-s++++A++E++M++HIJCJE+E++I++c++EoxAHp72H2Q+++++
  186. ***** END OF BLOCK 1 *****
  187.  
  188.